home *** CD-ROM | disk | FTP | other *** search
/ Gold Medal Software 1 / Gold Medal Software Volume 1 (Gold Medal) (1994).iso / prog / tpwprog7.arj / CHILD.PAS next >
Encoding:
Pascal/Delphi Source File  |  1992-07-02  |  4.1 KB  |  168 lines
  1. { child.pas -- Demonstrate child windows }
  2.  
  3. program Child;
  4.  
  5. {$R child.res}
  6.  
  7. uses WinTypes, WinProcs, WObjects;
  8.  
  9. const
  10.  
  11.   id_Menu  = 100;    { Menu resource ID }
  12.   cm_Open  = 101;    { Command IDs }
  13.   cm_Close = 102;
  14.   cm_Quit  = 103;
  15.  
  16. type
  17.  
  18.   ChildApplication = object(TApplication)
  19.     procedure InitMainWindow; virtual;
  20.   end;
  21.  
  22.   PMainWindow = ^MainWindow;
  23.   PChildWindow = ^ChildWindow;
  24.  
  25.   MainWindow = object(TWindow)
  26.     MyChild: PChildWindow;
  27.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  28.     procedure CMOpen(var Msg: TMessage);
  29.       virtual cm_First + cm_Open;
  30.     procedure CMClose(var Msg: TMessage);
  31.       virtual cm_First + cm_Close;
  32.     procedure CMQuit(var Msg: TMessage);
  33.       virtual cm_First + cm_Quit;
  34.     procedure ParentNotify(var Msg: TMessage);
  35.       virtual wm_First + wm_ParentNotify;
  36.     procedure WMLButtonDown(var Msg: TMessage);
  37.       virtual wm_First + wm_LButtonDown;
  38.   end;
  39.  
  40.   ChildWindow = object(TWindow)
  41.     MyParent: PMainWindow;
  42.     constructor Init(AParent: PWindowsObject;
  43.       ATitle: PChar; AStyle: LongInt);
  44.     destructor Done; virtual;
  45.     procedure WMLButtonDown(var Msg: TMessage);
  46.       virtual wm_First + wm_LButtonDown;
  47.   end;
  48.  
  49.  
  50. { ChildApplication }
  51.  
  52. {- Initialize ChildApplication object's window }
  53. procedure ChildApplication.InitMainWindow;
  54. begin
  55.   MainWindow := New(PMainWindow, Init(nil, 'Child Window Demo'))
  56. end;
  57.  
  58.  
  59. { MainWindow }
  60.  
  61. {- Construct MainWindow object }
  62. constructor MainWindow.Init(AParent: PWindowsObject; ATitle: PChar);
  63. begin
  64.   TWindow.Init(AParent, ATitle);
  65.   Attr.Menu := LoadMenu(HInstance, PChar(id_Menu));
  66.   MyChild := nil
  67. end;
  68.  
  69. {- Reopen the child windows }
  70. procedure MainWindow.CMOpen(var Msg: TMessage);
  71. begin
  72.   if MyChild <> nil then
  73.     SetFocus(MyChild^.HWindow)
  74.   else
  75.     MyChild := PChildWindow(
  76.       Application^.MakeWindow(New(PChildWindow,
  77.  
  78.       Init(@Self, 'Normal Child',
  79.       ws_Child or ws_Visible or ws_OverlappedWindow))))
  80.  
  81. (* Note: Before implementing these two alternate child windows,
  82.    make MyChild a global variable and modify ChildWindow.Done
  83.    to set that variable to nil directly rather than via the
  84.    MyParent pointer.
  85.  
  86.       Init(@Self, 'Child With Parent',
  87.       ws_Popup or ws_Visible or ws_OverlappedWindow))))
  88.  
  89.       Init(nil, 'Child Without Parent',
  90.       ws_Popup or ws_Visible or ws_OverlappedWindow))))
  91. *)
  92. end;
  93.  
  94. {- Close the child windows }
  95. procedure MainWindow.CMClose(var Msg: TMessage);
  96. begin
  97.   if MyChild <> nil then
  98.   begin
  99.     MyChild^.CloseWindow;
  100.     MyChild := nil
  101.   end
  102. end;
  103.  
  104. {- Quit the application }
  105. procedure MainWindow.CMQuit(var Msg: TMessage);
  106. begin
  107.   CloseWindow  { Also closes any open child windows }
  108. end;
  109.  
  110. {- Runs when child is created, destroyed, or selected }
  111. procedure MainWindow.ParentNotify(var Msg: TMessage);
  112. begin
  113.   if Msg.WParam = wm_Destroy then
  114.     MyChild := nil
  115. end;
  116.  
  117. {- Respond to left mouse button click in parent }
  118. procedure MainWindow.WMLButtonDown(var Msg: TMessage);
  119. begin
  120.   MessageBox(HWindow, 'Inside main window', 'Left Button', mb_Ok)
  121. end;
  122.  
  123.  
  124. { ChildWindow }
  125.  
  126. {- Construct child window object }
  127. constructor ChildWindow.Init(AParent: PWindowsObject;
  128.   ATitle: PChar; AStyle: LongInt);
  129. begin
  130.   TWindow.Init(AParent, ATitle);
  131.   MyParent := PMainWindow(AParent);
  132.   with Attr do
  133.   begin
  134.     Style := AStyle and not ws_SysMenu;
  135.     X := 0; Y := 0; W := 250; H := 150
  136.   end
  137. end;
  138.  
  139. {- Destroy child window }
  140. destructor ChildWindow.Done;
  141. begin
  142.   if MyParent <> nil then
  143.     MyParent^.MyChild := nil;
  144.   TWindow.Done
  145. end;
  146.  
  147. {- Respond to left mouse button click in child }
  148. procedure ChildWindow.WMLButtonDown(var Msg: TMessage);
  149. begin
  150.   MessageBox(HWindow, 'Inside child window', 'Left Button', mb_Ok)
  151. end;
  152.  
  153. var
  154.  
  155.   ChildApp: ChildApplication;
  156.  
  157. begin
  158.   ChildApp.Init('ChildApp');
  159.   ChildApp.Run;
  160.   ChildApp.Done
  161. end.
  162.  
  163.  
  164. {--------------------------------------------------------------
  165.   Copyright (c) 1991 by Tom Swan. All rights reserved.
  166.   Revision 1.00    Date: 5/8/1991
  167. ---------------------------------------------------------------}
  168.